Deaths In USA
Graphs of weekly deaths in the USA using CDC data
Data
https://www.cdc.gov/nchs/nvss/vsrr/covid19/excess_deaths.htm#dashboard
https://www.census.gov/data/tables/time-series/demo/popest/2010s-state-total.html
# devtools::install_github("derekmichaelwright/agData")
library(agData)Prepare Data
# Prep data
ages <- c("Under 25 years", "25-44 years", "45-64 years",
"65-74 years", "75-84 years", "85 years and older")
pp <- read.csv("data_usa_population.csv") %>%
select(Area, Population=X2019) %>%
mutate(Population = as.numeric(gsub(",","",Population)))
dd <- read.csv("data_usa_deaths.csv") %>%
rename(Area=1, Date=Week.Ending.Date) %>%
mutate(Date = as.Date(Date, format = "%m/%d/%Y"),
Julian.Day = lubridate::yday(Date),
Age.Group = factor(Age.Group, levels = ages),
Year = as.numeric(substr(Date, 1, 4)),
Group = ifelse(Year < 2020, "<2020", Year),
Group = factor(Group, levels = c("<2020", "2020", "2021", "2022", "2023")))
myColors <- c("darkgreen", "darkred", "darkorange", "steelblue", "darkblue")
myCaption <- c("\u00A9 www.dblogr.com/ | Data: CDC\nNote: recent data may be incomplete")Weekly Deaths
# Create plotting function
deathPlot1 <- function(area = "United States") {
# Prep data
vv <- as.Date(c("2015-01-01","2016-01-01","2017-01-01",
"2018-01-01","2019-01-01","2020-01-01",
"2021-01-01","2022-01-01"))
xx <- dd %>% filter(Area == area) %>%
group_by(Area, Date, Group) %>%
summarise(Value = sum(Number.of.Deaths))
myMin <- min(xx %>% filter(Group == "<2020") %>%
pull(Value), na.rm = T)
xx <- xx %>% filter(Value > myMin)
# Plot
ggplot(xx, aes(x = Date, y = Value / 1000)) +
geom_line(color = "darkred", size = 1, alpha = 0.8) +
geom_vline(xintercept = vv, lty = 2, alpha = 0.5) +
facet_wrap(Area ~ .) +
scale_x_date(date_breaks = "1 year", date_labels = "%Y",
minor_breaks = "1 year") +
theme_agData() +
labs(y = "Thousand Deaths Per Week", x = NULL, caption = myCaption)
}United States
mp <- deathPlot1(area = "United States")
ggsave("usa_deaths_1_01.png", mp, width = 8, height = 4)Yearly Deaths
# Create plotting function
deathPlot2 <- function(area = "United States") {
# Prep data
xx <- dd %>%
filter(Area == area) %>%
mutate(Year = as.numeric(substr(Date, 1, 4))) %>%
group_by(Area, Year, Group) %>%
summarise(Value = sum(Number.of.Deaths))
# Plot
ggplot(xx, aes(x = Year, y = Value / 1000000, fill = Group, alpha = Group)) +
geom_bar(stat = "identity", color = "black") +
facet_wrap(Area ~ .) +
scale_fill_manual(values = myColors) +
scale_alpha_manual(name = NULL, values = c(0.4,0.8,0.8,0.8,0.8)) +
scale_x_continuous(breaks = min(xx$Year):max(xx$Year)) +
theme_agData(legend.position = "none") +
labs(y = "Million Deaths", x = NULL, caption = myCaption)
}United States
mp <- deathPlot2(area = "United States")
ggsave("usa_deaths_2_01.png", mp, width = 6, height = 4)New York
mp <- deathPlot2(area = "New York")
ggsave("usa_deaths_2_02.png", mp, width = 6, height = 4)New Jersey
mp <- deathPlot2(area = "New Jersey")
ggsave("usa_deaths_2_03.png", mp, width = 6, height = 4)California
mp <- deathPlot2(area = "California")
ggsave("usa_deaths_2_04.png", mp, width = 6, height = 4)Texas
mp <- deathPlot2(area = "Texas")
ggsave("usa_deaths_2_05.png", mp, width = 6, height = 4)Florida
mp <- deathPlot2(area = "Florida")
ggsave("usa_deaths_2_06.png", mp, width = 6, height = 4)Washington
mp <- deathPlot2(area = "Washington")
ggsave("usa_deaths_2_07.png", mp, width = 6, height = 4)Montana
mp <- deathPlot2(area = "Montana")
ggsave("usa_deaths_2_08.png", mp, width = 6, height = 4)North Dakota
mp <- deathPlot2(area = "North Dakota")
ggsave("usa_deaths_2_09.png", mp, width = 6, height = 4)South Dakota
mp <- deathPlot2(area = "South Dakota")
ggsave("usa_deaths_2_10.png", mp, width = 6, height = 4)Deaths Vs. Previous Years
# Create plotting function
deathPlot3 <- function(areas = "United States") {
# Prep data
xx <- dd %>% filter(Area %in% areas) %>%
mutate(Area = factor(Area, levels = areas)) %>%
group_by(Area, Year, Group, Date, Julian.Day) %>%
summarise(Value = sum(Number.of.Deaths))
for(i in areas) {
myMin <- min(xx %>% filter(Area == i, Group == "<2020") %>%
pull(Value), na.rm = T)
xx <- xx %>% filter(!(Area == i & Value < myMin))
}
# Plot
ggplot(xx, aes(x = Julian.Day, y = Value / 1000,
color = Group, alpha = Group)) +
geom_line(aes(group = Year), size = 1) +
facet_wrap(Area ~ ., scales = "free_y", ncol = 5) +
scale_color_manual(name = NULL, values = myColors) +
scale_alpha_manual(name = NULL, values = c(0.4,0.8,0.8,0.8,0.8)) +
theme_agData(legend.position = "bottom") +
labs(x = "Julian Day", y = "Thousand Deaths Per Week",
caption = myCaption)
}United States
mp <- deathPlot3(areas = "United States")
ggsave("usa_deaths_3_01.png", mp, width = 6, height = 4)ggsave("featured.png", mp, width = 6, height = 4)
ggsave("../../posts_blog/usa_deaths/featured.png", mp, width = 6, height = 4)New York
mp <- deathPlot3(areas = "New York")
ggsave("usa_deaths_3_02.png", mp, width = 6, height = 4)New Jersey
mp <- deathPlot3(areas = "New Jersey")
ggsave("usa_deaths_3_03.png", mp, width = 6, height = 4)California
mp <- deathPlot3(areas = "California")
ggsave("usa_deaths_3_04.png", mp, width = 6, height = 4)Texas
mp <- deathPlot3(areas = "Texas")
ggsave("usa_deaths_3_05.png", mp, width = 6, height = 4)Florida
mp <- deathPlot3(areas = "Florida")
ggsave("usa_deaths_3_06.png", mp, width = 6, height = 4)Washington
mp <- deathPlot3(areas = "Washington")
ggsave("usa_deaths_3_07.png", mp, width = 6, height = 4)Montana
mp <- deathPlot3(areas = "Montana")
ggsave("usa_deaths_3_08.png", mp, width = 6, height = 4)North Dakota
mp <- deathPlot3(areas = "North Dakota")
ggsave("usa_deaths_3_09.png", mp, width = 6, height = 4)South Dakota
mp <- deathPlot3(areas = "South Dakota")
ggsave("usa_deaths_3_10.png", mp, width = 6, height = 4)Selected States
mp <- deathPlot3(areas = c("New York", "Texas", "Montana"))
ggsave("usa_deaths_3_11.png", mp, width = 12, height = 4)Weekly Deaths by Age Group
# Plotting function
deathPlot4 <- function(area) {
xx <- dd %>%
filter(Type == "Unweighted", Area == area)
for(i in unique(xx$Age.Group)) {
myMin <- min(xx %>% filter(Age.Group == i, Group == "<2020") %>%
pull(Number.of.Deaths), na.rm = T)
xx <- xx %>% filter(!(Age.Group == i & Number.of.Deaths < myMin))
}
# Plot
ggplot(xx, aes(x = Julian.Day, y = Number.of.Deaths,
color = Group, alpha = Group)) +
geom_line(aes(group = Year)) +
facet_grid(. ~ Age.Group) +
scale_color_manual(name = NULL, values = myColors) +
scale_alpha_manual(name = NULL, values = c(0.4,0.8,0.8,0.8,0.8)) +
theme_agData(legend.position = "bottom") +
labs(title = area, x = "Julian Day", y = "Weekly Deaths",
caption = myCaption)
}United States
mp <- deathPlot4(area = "United States")
ggsave("usa_deaths_4_01.png", mp, width = 12, height = 5)ggsave("featured.png", mp, width = 12, height = 5)New York
mp <- deathPlot4(area = "New York")
ggsave("usa_deaths_4_02.png", mp, width = 12, height = 5)New Jersey
mp <- deathPlot4(area = "New Jersey")
ggsave("usa_deaths_4_03.png", mp, width = 12, height = 5)California
mp <- deathPlot4(area = "California")
ggsave("usa_deaths_4_04.png", mp, width = 12, height = 5)Texas
mp <- deathPlot4(area = "Texas")
ggsave("usa_deaths_4_05.png", mp, width = 12, height = 5)Florida
mp <- deathPlot4(area = "Florida")
ggsave("usa_deaths_4_06.png", mp, width = 12, height = 5)Washington
mp <- deathPlot4(area = "Washington")
ggsave("usa_deaths_4_07.png", mp, width = 12, height = 5)Montana
mp <- deathPlot4(area = "Montana")
ggsave("usa_deaths_4_08.png", mp, width = 12, height = 5)North Dakota
mp <- deathPlot4(area = "North Dakota")
ggsave("usa_deaths_4_09.png", mp, width = 12, height = 5)South Dakota
mp <- deathPlot4(area = "South Dakota")
ggsave("usa_deaths_4_10.png", mp, width = 12, height = 5)Yearly Deaths by Age Group
# Plotting function
deathPlot5 <- function(area) {
# Prep data
xx <- dd %>%
filter(Type == "Unweighted", Area == area, Year < 2022) %>%
group_by(Year, Age.Group, Group) %>%
summarise(Number.of.Deaths = sum(Number.of.Deaths, na.rm = T))
# Plot
ggplot(xx, aes(x = Year, y = Number.of.Deaths / 1000,
fill = Group, alpha = Group)) +
geom_bar(stat = "identity", color = "black") +
facet_grid(. ~ Age.Group) +
scale_fill_manual(values = myColors) +
scale_alpha_manual(values = c(0.4,0.8,0.8,0.8,0.8)) +
scale_x_continuous(breaks = min(xx$Year):max(xx$Year)) +
theme_agData(legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = area, x = NULL, y = "Thousand Deaths", caption = myCaption)
}United States
mp <- deathPlot5(area = "United States")
ggsave("usa_deaths_5_01.png", mp, width = 12, height = 5)New York
mp <- deathPlot5(area = "New York")
ggsave("usa_deaths_5_02.png", mp, width = 12, height = 5)New Jersey
mp <- deathPlot5(area = "New Jersey")
ggsave("usa_deaths_5_03.png", mp, width = 12, height = 4)California
mp <- deathPlot5(area = "California")
ggsave("usa_deaths_5_04.png", mp, width = 12, height = 5)Texas
mp <- deathPlot5(area = "Texas")
ggsave("usa_deaths_5_05.png", mp, width = 12, height = 5)Florida
mp <- deathPlot5(area = "Florida")
ggsave("usa_deaths_5_06.png", mp, width = 12, height = 5)Washington
mp <- deathPlot5(area = "Washington")
ggsave("usa_deaths_5_07.png", mp, width = 12, height = 5)Montana
mp <- deathPlot5(area = "Montana")
ggsave("usa_deaths_5_08.png", mp, width = 12, height = 5)North Dakota
mp <- deathPlot5(area = "North Dakota")
ggsave("usa_deaths_5_09.png", mp, width = 12, height = 5)South Dakota
mp <- deathPlot5(area = "South Dakota")
ggsave("usa_deaths_5_10.png", mp, width = 12, height = 5)Death Rates
# Prep data
xx <- dd %>%
filter(Year > 2019, Type == "Unweighted") %>%
group_by(Area, State.Abbreviation, Date) %>%
summarise(Number.of.Deaths = sum(Number.of.Deaths, na.rm = T)) %>%
ungroup() %>%
left_join(pp, by = "Area") %>%
mutate(Death.Rate = 1000000 * Number.of.Deaths / Population)
# Plot
mp <- ggplot(xx, aes(x = Date, y = Death.Rate)) +
geom_line(color = "darkred", alpha = 0.8, size = 1) +
facet_wrap(Area ~ .) +
scale_color_manual(values = agData_Colors) +
scale_x_date(date_labels = "%Y", date_breaks = "1 year") +
theme_agData(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(x = NULL, y = "Deaths per million people per week",
caption = myCaption)
ggsave("usa_deaths_6_01.png", mp, width = 12, height = 12)North vs South Dakota
# Prep data
x1 <- xx %>% filter(State.Abbreviation %in% c("SD","ND"))
# Plot
mp <- ggplot(x1, aes(x = Date, y = Death.Rate, color = Area)) +
geom_line(size = 1) +
scale_color_manual(values = c("darkblue","steelblue")) +
theme_agData(legend.position = "bottom") +
labs(x = NULL, y = "Deaths per million people per week",
caption = myCaption)
ggsave("usa_deaths_6_02.png", mp, width = 6, height = 4)California vs Texas
# Prep data
x1 <- xx %>% filter(State.Abbreviation %in% c("CA","TX"))
# Plot
mp <- ggplot(x1, aes(x = Date, y = Death.Rate, color = Area)) +
geom_line(size = 1) +
scale_color_manual(values = c("darkred","darkblue")) +
theme_agData(legend.position = "bottom") +
labs(x = NULL, y = "Deaths per million people per week",
caption = myCaption)
ggsave("usa_deaths_6_03.png", mp, width = 6, height = 4)New York vs New Jersey vs Florida
# Prep data
colors <- c("darkred", "darkblue", "steelblue")
x1 <- xx %>% filter(State.Abbreviation %in% c("FL","NY","NJ"))
# Plot
mp <- ggplot(x1, aes(x = Date, y = Death.Rate, color = Area)) +
geom_line(size = 1) +
scale_color_manual(values = colors) +
theme_agData(legend.position = "bottom") +
labs(x = NULL, y = "Deaths per million people per week",
caption = myCaption)
ggsave("usa_deaths_6_04.png", mp, width = 6, height = 4)All Data
# Prep data
xx <- dd %>%
filter(Type == "Unweighted",
State.Abbreviation %in% c("FL","NY","NJ")) %>%
group_by(Area, State.Abbreviation, Date) %>%
summarise(Number.of.Deaths = sum(Number.of.Deaths, na.rm = T)) %>%
ungroup() %>%
left_join(pp, by = "Area") %>%
mutate(Death.Rate = 1000000 * Number.of.Deaths / Population)
# Plot
mp <- ggplot(xx, aes(x = Date, y = Death.Rate, color = Area)) +
geom_line(size = 1) +
scale_color_manual(values = colors) +
scale_x_date(date_breaks = "1 year", date_label = "%Y") +
theme_agData(legend.position = "bottom",
axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(x = NULL, y = "Deaths per million people per week",
caption = myCaption)
ggsave("usa_deaths_6_05.png", mp, width = 6, height = 4)© Derek Michael Wright www.dblogr.com/